home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / ahd2.arc / AHD-2.BAS (.txt)
Encoding:
GW-BASIC  |  1985-07-22  |  13.0 KB  |  270 lines
  1. 10  CLS:PRINT:PRINT:PRINT "          AHD-2 ... Applied Hydraulic Design Program "
  2. 15  PRINT:PRINT:CLOSE
  3. 16  '
  4. 17  ' Original program author: Dr. M. Dougal, Civil Engr., ISU
  5. 18  ' Converted from Fortran to Basic by Dr. R.G. Allen, Civil Engr., ISU:1/85
  6. 19  '                Circular Sections and specific force added 1/85.
  7. 20  '
  8. 21  PRINT " Enter the name of your data file to read or an  S  for screen input (E to end)"
  9. 25  INPUT FILE$:IF FILE$ = "E" THEN GOTO 2000
  10. 26  OPEN "SCRN:" FOR OUTPUT AS #2
  11. 27  PRINT:PRINT " Do you wish output to be routed to a" :PRINT "   (P) Printer and screen, or":PRINT "   (F) Output file and screen, or":PRINT "   (S) Screen only"
  12. 28  INPUT O$:IF O$="F" THEN 30 ELSE IF O$="P" THEN 29 ELSE IF O$<>"S" THEN 27 ELSE GOTO 35
  13. 29  OPEN "LPT1:" FOR OUTPUT AS #3:GOTO 35
  14. 30  PRINT:INPUT " Output file name ";OF$:OPEN OF$ FOR OUTPUT AS #3
  15. 35  IF FILE$ <> "S" THEN OPEN FILE$ FOR INPUT AS #1
  16. 40  IF FILE$ <> "S" THEN INPUT #1,ICALC,ID$:GOTO 150
  17. 50  PRINT " Code        Type of Problems Solved":PRINT "(ICALC)"
  18. 60  PRINT "  1    Specific energy curve data and critical depth, for given Q"
  19. 70  PRINT "  2    Normal depth and S-Q curve data up to Normal Depth for given Q"
  20. 80  PRINT "  3    Both 1 and 2 solved in one run
  21. 90  PRINT "  4    S-Q curve computed for given range of depths"
  22. 100  PRINT "  5    Discharge and critical depth computed for given normal depth"
  23. 110  PRINT "  6    Water surface profile computed for given discharge, starting"
  24. 120  PRINT "        depth and desired end depth (Direct Step Method)"
  25. 130  PRINT:PRINT:INPUT " Enter the desired ICALC value (1-6) ",ICALC
  26. 140  PRINT:INPUT " Problem Title ",ID$
  27. 150  B=0:Z=0:RCN=0:SL=0:QD=0:DIN=0:DELD1=0:DFIN=0:DST=0:DELD2=0:STAIN=0:ELEVIN=0
  28. 152  IF ICALC =0 THEN GOTO 2000
  29. 155  IF FILE$ <> "S" THEN INPUT #1,JTYP,B,Z,RCN,SL,QD,DIN,DELD1,DFIN,DST,DELD2,STAIN,ELEVIN:GOTO 300
  30. 160  PRINT "Enter 1 for a uniform, trapezoidal or rectangular channel"
  31. 162  PRINT "      2 for a depressed culvert invert "
  32. 163  PRINT "   or 3 for a circular cross-section":INPUT JTYP
  33. 170  IF JTYP < 3 THEN INPUT "Enter the bottom width of the channel in feet (B) ",B
  34. 172  IF JTYP = 3 THEN INPUT "Enter the diameter of circular channel in feet (B) ",B
  35. 180  IF JTYP < 3 THEN INPUT "Enter the sideslope, horiz. to vert. (0 is vertical) (Z) ",Z
  36. 190  INPUT "Enter the value of Manning's roughness coefficient (RCN) ",RCN
  37. 200  INPUT "Enter the slope of invert of channel, ft/ft (positive,0,or neg) (SL) ",SL
  38. 210  INPUT "Enter the design discharge (0 if unknown for ICALC=4 or 5) (QD) ",QD
  39. 220  INPUT "Enter the initial depth to begin calculations (ICALC=1-5) (not 0) (DIN) ",DIN
  40. 230  PRINT "Enter the depth increment for computing successive values for S-Q ":INPUT " (i.e. 0.50 for mild and 0.25 for steep slopes) (DELD1) ",DELD1
  41. 240  PRINT "For ICALC =1-5 enter the max. depth for calculations (B if unknown)"
  42. 250  PRINT "For ICALC = 6  enter the depth at which water surface calculations stop":INPUT " (Usually normal depth) (DFIN) ",DFIN:IF ICALC < 6 THEN GOTO 295
  43. 260  INPUT "Enter the starting depth for ICALC = 6 (water surface profile) (DST) ",DST
  44. 270  INPUT "Enter the increment of depth (.25-.5 for mild, .1-.25 for steep (DELD2) ",DELD2
  45. 280  PRINT "Enter the initial stationing of the channel at the point where WSP computations"
  46. 290  INPUT "are to begin (at depth=DST).  Stationing should proceed upstream (STAIN) ",STAIN
  47. 295  INPUT "Enter the elevation of the channel invert at the initial station (ELEVIN) ",ELEVIN
  48. 300  '
  49. 305  IF B < 0 THEN 1900
  50. 310  IF B=0 THEN 320 ELSE GOTO 330
  51. 320  IF Z<0 THEN 1900
  52. 330  I=2:GOSUB 332:IF O$<>"S" THEN I=3:GOSUB 332
  53. 331  GOTO 475
  54. 332  PRINT #I,"           CE 472. APPLIED HYDRAULIC DESIGN (AHD-2)"
  55. 340  PRINT #I," SOLUTION OF NORMAL DEPTH, CRITICAL DEPTH, AND WATER SURFACE "
  56. 350  PRINT #I,"         PROFILE PROBLEMS IN SIMPLE CHANNEL SECTIONS"
  57. 360  PRINT#I,:PRINT #I, ID$
  58. 370  PRINT#I,:PRINT #I,
  59. 380  PRINT #I, "                       HYDRAULIC INPUT DATA"
  60. 385  PRINT #I," CHANNEL DATA"
  61. 390  PRINT #I,   "      B       Z       N      SL       STAIN     ELEVIN"
  62. 400  PRINT #I,USING "    ###.#   ###.#  ##.#### #.##### ######.## ######.##";B,Z,RCN,SL,STAIN,ELEVIN
  63. 410  PRINT#I,:PRINT#I,:PRINT#I," DISCHARGE AND DEPTH DATA":PRINT#I,
  64. 420  PRINT #I,   "     QD      DIN    DELD1   DFIN      DST     DELD2"
  65. 430  PRINT #I,USING "######.#  ###.##   ##.###  ###.##  ####.##  ####.##";QD,DIN,DELD1,DFIN,DST,DELD2
  66. 440  PRINT#I,:PRINT#I,
  67. 450  IF JTYP = 1 THEN PRINT #I, " DESIGN CHANNEL HAS A REGULAR CHANNEL SHAPE, RECTANGULAR OR TRAPEZOIDAL.":GOTO 470
  68. 460  IF JTYP = 2 THEN PRINT #I," DESIGN CHANNEL IS A DEPRESSED CULVERT INVERT SECTION OF I.H.C  ":GOTO 470
  69. 465  IF JTYP = 3 THEN PRINT #I,USING" DESIGN CHANNEL IS A CIRCULAR CROSS-SECTION OF DIAMETER ###.## feet";B
  70. 470  PRINT #I,:PRINT #I,USING " ICALC = ###";ICALC:PRINT #I,:RETURN
  71. 475  IF PN=1 THEN GOSUB 6330 'LINE PRINTER
  72. 480  HYP=Z*Z+1:ROOT1=SQR(HYP):IF SL <> 0 THEN GOTO 490 ELSE GOTO 500
  73. 490  SLHYP=SL*SL+1:ROOT3=SQR(SLHYP):GOTO 510
  74. 500  SLHYP=1:ROOT3=1
  75. 510  CFACT=1/ROOT3
  76. 520  '
  77. 530  ' PRINT OUT THE TYPE OF PROBLEM WHICH IS BEING SOLVED
  78. 540  '
  79. 550  IF ICALC=1 THEN GOTO 600 ELSE IF ICALC=2 THEN GOTO 610 ELSE IF ICALC=3 THEN GOTO 620
  80. 560  IF ICALC=4 THEN GOTO 630 ELSE IF ICALC=5 THEN GOTO 640 ELSE IF ICALC=6 THEN GOTO 650
  81. 600  PRINT "Calculate the Specific Energy Curve and Critical Depth for a Given Discharge":GOTO 720
  82. 610  PRINT "Calculate S-Q Curve Data and Normal Depth for a Given Discharge and Channel":GOTO 1060
  83. 620  PRINT "Calculate the Specific Energy Curve, Critical Depth, S-Q Curve and Normal Depth":GOTO 720
  84. 630  PRINT "Calculate S-Q Curve Data for Given Range of Depths and Channel Characteristics":GOTO 1300
  85. 640  PRINT "Calculate Design Discharge and Specific Energy Data and Critical Discharge":PRINT" for a given Normal Depth of Flow and Channel Characteristics":GOTO 1300
  86. 650  PRINT "Calculate a Water Surface Profile for an A,C,H,M, or S Curve for a Given ":PRINT "Discharge, Starting Depth and Channel Characteristics":GOTO 1600
  87. 720  '
  88. 730  '  Compute Specific Energy Curve and Critical Depth
  89. 740  '
  90. 750  IF QD <= 0 THEN 760 ELSE 770
  91. 760  PRINT USING "STOP  QD = ###.## CFS.  DIN = #### feet";QD,DIN:GOTO 1900
  92. 770  IF DIN <=0 THEN GOTO 760
  93. 780  I=2:GOSUB 782:IF O$ <>"S" THEN I=3:GOSUB 782
  94. 781  GOTO 820
  95. 782  PRINT#I,:PRINT#I,:PRINT #I," Computation of Specific Energy and Force Data and Critical Depth":PRINT#I,
  96. 790  PRINT #I,"Depth   Elev.   Area   Top   Mean  Veloc.  Vel.  Ratio  Spec.   Spec.   Elev.TH."
  97. 800  PRINT #I,"         W.S.         Width  Depth         Head  VH/DM  Head    Force     Line "
  98. 810  PRINT #I,"  ft.     ft.  sq.ft.  ft.    ft.    fps    ft.          ft.      lb.      ft. ":RETURN
  99. 820  D=DIN:DHOLD=DELD1/2
  100. 830  FOR N = 1 TO 100:GOSUB 5000:IF JTYP=3 AND D>B THEN 890
  101. 840  SH=D*CFACT+VH:ELWS=ELEVIN+D*CFACT:ELTH=ELEVIN+SH:SFORCE=(QD*QD/32.17/A+A*YBAR)*62.4
  102. 845  I=2:GOSUB 850:IF O$<>"S" THEN I=3:GOSUB 850
  103. 846  GOTO 860
  104. 850  PRINT #I,USING "###.## ####.## ####.# ###.# ###.## ###.## ###.## ###.## ###.## ######. ####.##";D,ELWS,A,T,DM,V,VH,QUOT,SH,SFORCE,ELTH:RETURN ' print subroutine
  105. 860  IF QUOT-0.5 <=0 THEN 870 ELSE DHOLD=D
  106. 870  IF DFIN-D <= 0 THEN 890
  107. 880  D=D+DELD1:NEXT N
  108. 890  D=DHOLD:DELD3=DELD1
  109. 900  FOR N=1 TO 100:GOSUB 5000:IF JTYP=3 AND D>B THEN 1020
  110. 910  IF QUOT-0.5 < 0 THEN 930 ELSE IF QUOT-0.5 = 0 THEN 980
  111. 920  D=D+DELD3:GOTO 950
  112. 930  RATIO=QUOT/0.5:IF RATIO-0.999 < 0 THEN 940 ELSE 980
  113. 940  D=D-DELD3:DELD3=DELD3/2:D=D+DELD3
  114. 950  NEXT N
  115. 980  SH=D*CFACT+VH:SFORCE=(QD*QD/32.17/A+A*YBAR)*62.4
  116. 990  ELWS=ELEVIN+D*CFACT:ELTH=ELEVIN+SH:DCR=D
  117. 1000  I=2:GOSUB 1002:IF O$<>"S" THEN I=3:GOSUB 1002
  118. 1001  GOTO 1010
  119. 1002  PRINT#I,:PRINT #I,USING " Critical Depth Results for #####.# CFS";QD:PRINT#I,:RETURN
  120. 1010  I=2:GOSUB 850 :IF O$<>"S" THEN I=3:GOSUB 850PRINT RESULTS
  121. 1020  IF ICALC <> 3 THEN 1900 'stop
  122. 1030  '
  123. 1040  ' Compute normal depth and S-Q curve for given discharge
  124. 1050  '
  125. 1060  D=DIN:I=2:GOSUB 1070:IF O$<>"S" THEN I=3:GOSUB 1070
  126. 1065  GOTO 1100
  127. 1070  PRINT #I,:PRINT #I,:PRINT #I," Computation of Stage-Discharge Using Manning's Equation":PRINT #I,
  128. 1080  PRINT #I," Depth  Area  W.P.  Hyd.R.  Veloc.  Disch.  Vel.Head  Sp.Head  El. W.S.  El.TH."
  129. 1090  PRINT #I,"   ft. sq.ft.  ft.   ft.     fps     cfs       ft.      ft.      ft.       ft. " ' print subroutine
  130. 1093  RETURN
  131. 1095  PRINT #I,USING"###.## ####.# ###.# ###.### ##.### #####.##  ###.###  ###.### #####.## ####.##";D,A,WP,R,VEL,Q,VELHD,SH,ELWS,ELTH:RETURN ' print subroutine
  132. 1100  IF SL <=0 THEN 1110 ELSE 1120
  133. 1110  PRINT USING "STOP   SL = ##.#####   DIN = ####.### ft";SL,DIN:GOTO 1900 'stop
  134. 1120  IF DIN <=0 THEN 1110
  135. 1130  DELD3=DELD1:ROOT2=SQR(SL)
  136. 1140  FOR N=1 TO 100:GOSUB 5000:IF JTYP=3 AND D>B THEN 1900
  137. 1150  VEL=(1.486/RCN)*(R^0.6667)*ROOT2:Q=VEL*A:VELHD=VEL^2/64.32
  138. 1160  ELWS=ELEVIN+D*CFACT:ELTH=ELWS+VELHD:SH=D*CFACT+VELHD
  139. 1170  IF QD-Q < 0 THEN 1180 ELSE IF QD-Q = 0 THEN 1250 ELSE GOTO 1220
  140. 1180  RATIO=Q/QD
  141. 1190  IF 1.001-RATIO < 0 THEN 1200 ELSE GOTO 1250
  142. 1200  D=D-DELD3:DELD3=DELD3/2:D=D+DELD3:GOTO 1240
  143. 1210  '
  144. 1220  I=2:GOSUB 1095:IF O$<>"S" THEN I=3:GOSUB 1095
  145. 1230  D=D+DELD3
  146. 1240  NEXT N
  147. 1250  DEPN=D:I=2:GOSUB 1095:GOSUB 1254:IF O$<>"S" THEN I=3:GOSUB 1095:GOSUB 1254
  148. 1253  GOTO 1255
  149. 1254  PRINT#I,:PRINT #I,USING" Normal Depth = ###.## ft.  Computed Discharge = #####.## CFS";DEPN,Q:RETURN
  150. 1255  GOTO 1900
  151. 1260  '
  152. 1270  ' Compute S-Q curve data for given range of depth or for given normal depth
  153. 1280  '
  154. 1300  D=DIN:PRINT
  155. 1310  GOSUB 1070
  156. 1320  IF SL <=0 THEN GOTO 1110
  157. 1330  IF DIN <= 0 THEN GOTO 1110
  158. 1340  DELD3=DELD1:ROOT2=SQR(SL)
  159. 1350  FOR N=1 TO 100:GOSUB 5000:IF JTYP=3 AND D>B THEN 1900
  160. 1360  VEL=(1.486/RCN)*(R^0.6667)*ROOT2:Q=VEL*A:VELHD=VEL^2/64.32
  161. 1370  ELWS=ELEVIN+D*CFACT:ELTH=ELWS+VELHD:SH=D*CFACT+VELHD
  162. 1380  IF DFIN-D < 0 THEN 1390 ELSE IF DFIN-D = 0 THEN 1420 ELSE 1400
  163. 1390  D=DFIN:GOTO 1410
  164. 1400  I=2:GOSUB 1095:IF O$<>"S" THEN I=3:GOSUB 1095
  165. 1410  D=D+DELD1:NEXT N
  166. 1420  DEPN=D:I=2:GOSUB 1095:GOSUB 1254:IF O$<>"S" THEN I=3:GOSUB 1095:GOSUB 1254
  167. 1450  IF ICALC <> 5 THEN GOTO 1900
  168. 1460  '
  169. 1470  ' Compute Discharge for Given Normal Depth.
  170. 1480  '    Then Compute Critical Depth and Specific Energy Data
  171. 1490  '
  172. 1500  QD=Q:IF SL <= 0.03 THEN 1550
  173. 1510  IF B < 10 THEN 1520 ELSE 1540
  174. 1520  DFIN=B:GOTO 1550
  175. 1530  '
  176. 1540  DFIN=10
  177. 1550  IF DELD1 < 0.25 THEN 1560 ELSE 1570
  178. 1560  DELD1=0.25
  179. 1570  GOTO  750
  180. 1580  '
  181. 1590  'Compute Water Surface Profile for Given Discharge and Depth Conditions
  182. 1600  '
  183. 1610  D=DST:ILINES=50:I=2:GOSUB 1620:IF O$<>"S" THEN I=3:GOSUB 1620
  184. 1615  GOTO 1670
  185. 1620  PRINT #I,:PRINT #I,"           Computation of Water Surface Profile"
  186. 1630  PRINT #I,USING"            for Discharge of #####.## cfs";QD
  187. 1640  PRINT #I," Station   Invert  Depth    W.S.   Veloc.  Vel.Head   Elev.   Del.Dist   Total"
  188. 1650  PRINT #I,"           Elev.           Elev.                       T.H.            Distance"
  189. 1660  PRINT #I,"            ft.     ft.     ft.     fps       ft.      ft.      ft.       ft. " ' print subroutine
  190. 1662  RETURN
  191. 1665  PRINT #I,USING"######.## ####.## ###.### ####.## ####.## #####.### #####.### #####.## ######.#";STAIN,ELEVIN,D1,ELEVWS,V,VH,ELEVTH,DDIST,TDIST
  192. 1666  RETURN
  193. 1667  PRINT #I,USING"######.## ####.## ###.### ####.## ####.## #####.### #####.### #####.## ######.#";STAT,ELEVB,D2,ELEVWS,V,VH,ELEVTH,DDIST,TDIST:RETURN
  194. 1670  IF DST <= 0 THEN 1680 ELSE 1690
  195. 1680  PRINT USING " STOP...DST = ####.### ft";DST
  196. 1690  CHECK=ABS(DFIN-DST):NN=CHECK/DELD2:ICOUNT=1:TDIST=0:DDIST=0
  197. 1700  GOSUB 5000:IF JTYP=3 AND D>B THEN 1900
  198. 1710  ELEVWS=ELEVIN+D*CFACT:ELEVTH=ELEVWS+VH:SH=D*CFACT+VH
  199. 1720  SF=((RCN^2)*(V^2))/(2.2082*(R^1.3333)):SF1=SF:H1=SH:D1=D
  200. 1730  I=2:GOSUB 1665:IF O$<>"S" THEN I=3:GOSUB 1665
  201. 1740  IF DST-DFIN <0 THEN 1760 ELSE IF DST-DFIN = 0 THEN 1890
  202. 1750  DELD2=-DELD2
  203. 1760  D=D+DELD2
  204. 1770  FOR N=1 TO 100:GOSUB 5000:IF JTYP=3 AND D>B THEN 1900
  205. 1780  SH=D*CFACT+VH:SF=((RCN^2)*(V^2))/(2.2082*(R^1.3333))
  206. 1790  SF2=SF:H2=SH:D2=D:SFAVG=(SF1+SF2)/2
  207. 1800  DDIST=(H2-H1)/(SL-SFAVG):TDIST=TDIST+DDIST:STAT=STAIN-TDIST
  208. 1810  ELEVB=ELEVIN-(SL*TDIST):ELEVWS=ELEVB+D2*CFACT:ELEVTH=ELEVB+H2
  209. 1820  I=2:GOSUB 1667:IF O$<>"S" THEN I=3:GOSUB 1667
  210. 1830  ICOUNT=ICOUNT+1:SF1=SF2:H1=H2:D1=D2:D=D+DELD2
  211. 1840  IF NN-N <0 THEN 1880
  212. 1850  IF ICOUNT-ILINES <0 THEN GOTO 1870
  213. 1860  PRINT:PRINT:GOSUB 1620:ILINES=ILINES+50
  214. 1870  IF D <= 0 THEN PRINT "Depth is approaching zero.":GOTO 1900
  215. 1872  NEXT N
  216. 1880  '
  217. 1890  I=2:GOSUB 1892:IF O$<>"S" THEN I=3:GOSUB 1892
  218. 1891  GOTO 1900
  219. 1892  PRINT #I,USING " Flow is at or near the depth DFIN = #####.### ft";DFIN:RETURN
  220. 1900  PRINT:PRINT " End of Problem.   Start new Problem" :PRINT:PRINT
  221. 1905  I=3:IF O$="S" THEN 1910 ELSE PRINT #I,:PRINT #I," End of Problem":PRINT #I,CHR$(12) 'Formfeed
  222. 1910  PRINT "Press RETURN to continue ":INPUT W$ 'begin new problem
  223. 1950  IF FILE$ <> "S" THEN GOTO 40 ELSE GOTO 10
  224. 2000  PRINT "End of AHD-2 Program......Thank You." :PRINT:GOTO 5330
  225. 5000  '
  226. 5010  '
  227. 5020  'SUBROUTINE COMPUT
  228. 5030  '
  229. 5040  '  Subroutine COMPUT is for computing area factors for three different
  230. 5050  '  Cross-Sections.
  231. 5060  '
  232. 5070  IF JTYP =1 THEN 5080 ELSE IF JTYP = 2 THEN 5090 ELSE GOTO 5250
  233. 5075  ' Trapezoidal
  234. 5080  A=B*D+Z*D*D:WP=B+2*D*ROOT1:YBAR=D*(0.5+Z*D/B/3)/(1+Z/B*D):GOTO 5230
  235. 5085  ' Culvert inverts
  236. 5086  ' Area and W.P. calc's for culvert invert were modified to calculate
  237. 5087  ' for sloping sidewalls.  1/85  R.G.Allen
  238. 5090  IF B < 6 THEN 5100 ELSE 5200
  239. 5100  IF D <= 0.25 THEN 5110 ELSE 5120
  240. 5110  A=(B-1.667)*D+2*D*D:WP=(B-1.667)+4.472*D
  241. 5111  YBAR=D*(0.5+D/3*(2/(B-1.667)))/(1+2/(B-1.667)*D) 'centroid
  242. 5112  GOTO 5230
  243. 5118  '   Following constant changed from .0592 to 1.12    1/85
  244. 5120  A=B*D+Z*D*D-0.2917:WP=B+1.12+2*(D-0.25)*ROOT1
  245. 5121  DA=D-0.25:YBAR= (DA*(0.5+DA/3*(Z/(B+2*Z*0.25)))/(1+Z/(B+2*Z*0.25)*DA)*((B+2*Z*0.25)*DA+DA*DA*Z) + ((B-1.667)*0.25+0.125)*(0.25*(0.5+2/(B-1.667)*0.25/3)/(1+2/(B-1.667)*0.25)) )/A 'centroid
  246. 5122  GOTO 5230
  247. 5200  IF D <= 0.33 THEN 5210 ELSE 5220
  248. 5210  A=(B-2.3333)*D+2*D*D:WP=(B-2.3333)+4.472*D
  249. 5211  YBAR=D*(0.5+D/3*(2/(B-2.333)))/(1+2/(B-2.333)*D) 'centroid
  250. 5212  GOTO 5230
  251. 5218  '   Following constant changed from .0783 to 1.49    1/85
  252. 5220  A=B*D+Z*D*D-0.5556:WP=B+1.49+2*(D-0.333)*ROOT1
  253. 5221  DA=D-0.33:YBAR= (DA*(0.5+DA/3*(Z/(B+2*Z*0.33)))/(1+Z/(B+2*Z*0.33)*DA)*((B+2*Z*0.33)*DA+DA*DA*Z) + ((B-2.333)*0.33+0.222)*(0.33*(0.5+2/(B-2.333)*0.33/3)/(1+2/(B-2.333)*0.33)) )/A 'centroid
  254. 5230  '
  255. 5240  R=A/WP:T=B+2*Z*D:DM=A/T:V=QD/A:VH=V^2/64.32:QUOT=VH/DM:GOTO 5320
  256. 5250  ' Circular cross-sections    R.G.Allen 1/85
  257. 5255  IF D>B THEN I=2:GOSUB 5257:IF O$<>"S" THEN I=3:GOSUB 5257
  258. 5256  GOTO 5258
  259. 5257  PRINT #I,USING" Depth ###.## exceeds diameter ###.## ...Quitting";D,B:RETURN
  260. 5258  IF D>B THEN GOTO 5320
  261. 5260  PI=3.14159:ARG=(B-2*D)/B:THETA=2*PI+2*(ATN(ARG/SQR(-ARG*ARG+1))-1.5708)
  262. 5270  A=((2*PI - THETA)+SIN(THETA))/8 * B^2:WP=(2*PI - THETA) * B/2
  263. 5280  R=A/WP:T=SIN(THETA/2)*B:DM=A/T:V=QD/A:VH=V^2/64.32:IF DM>D THEN DM=D
  264. 5281  IF DM<-D THEN DM=D
  265. 5282  QUOT=VH/DM
  266. 5285  ALPHA=(2*PI - THETA)/2:YR=(B*SIN(ALPHA)/3*(B/2)*(B/2) - T/3*(B/2-D)*(B/2-D))/A:YBAR=YR+D-B/2 'centroid of circular section
  267. 5320  RETURN
  268. 5330  CLOSE:END
  269. 6000  '
  270.